home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0054_Wav Player.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-25  |  8KB  |  297 lines
  1. {
  2. >Does anybody know how to load and play a wav in pascal? And I still need to
  3. >know how to load mods. And I would like to know how to load any other sound
  4. >files that you know of other than pc speaker beeps. Thanks
  5.  
  6. I made a WAV player in Pascal, but the source is a few lines long.  <G>
  7.  
  8.  Okay.  It will play 4-bit ADPCM wavs, but not well.  Need to get the SB
  9. developer's kit to figure out why.  Oh well.
  10. }
  11.  
  12. {$M 16384,0,655360}
  13.  
  14. uses Dos, CRT, objects;
  15.  
  16. const SBase = $220;               {Default port base for Sound Blaster.
  17.                                    Change if necessary}
  18.       SIrq  = 7;                  {Default Irq line for Sound Blaster.
  19.                                    Change if necessary}
  20.       SDMA  = 1;                  {Default DMA channel for Sound Blaster.}
  21.  
  22. type
  23.  TWAVRec = record
  24.              ID: LongInt;
  25.             Len: LongInt;
  26.            end;
  27.  PWAVFmt = ^TWAVFmt;
  28.  TWAVFmt = record
  29.             case word of
  30.              1:( FTag: word;
  31.                  NChan: word;
  32.                  SampR: word;
  33.                  AvgSR: word;
  34.                  BLKAl: word;
  35.                  FMTLen: word;
  36.                  FMTDat: array[0..256] of byte);
  37.              2:( Chunk:Pointer);
  38.            end;
  39. var
  40.  WAVFile: TDosStream;             {WAV file object}
  41.  BlkID: TWAVRec;                  {ID for each block in WAV}
  42.  BlkFmt: PWAVFmt;                 {Block format}
  43.  TotalSz: LongInt;                {Total size of WAV data}
  44.  DSPCmd: byte;
  45.  NumBits: byte;
  46.  SampByte: byte;
  47.  BlockSize: word;
  48.  EOB: boolean;
  49.  DF: String;
  50.  
  51. procedure NewBlock; interrupt;    {Procedure to set up next block or}
  52. var X:Byte;                       {end playback}
  53. begin
  54.  
  55.  X := port[SBase+$e];
  56.  port[$20] := $20;
  57.  EOB := true;
  58.  
  59. end;
  60.  
  61. procedure PrepareSB;
  62. begin
  63.  
  64.  SetIntVec(SIrq + 8, @NewBlock);           {Set up service routine}
  65.  
  66.  asm
  67.   in al,$61                                 {Enable timer 2, but}
  68.   and al,$fc                                {do not turn on sound.}
  69.   or al,1
  70.   out $61,al
  71.  
  72.   sti
  73.  
  74.   mov dx,SBase+6                            {DSP (Digital Sound Processor)
  75.                                              reset port}
  76.   mov al,1                                  {Reset command}
  77.   out dx,al
  78.  
  79.   mov bx,4
  80.   call @9                                   {Wait 4 clocks}
  81.  
  82.   mov al,0                                  {Normal mode}
  83.   out dx,al
  84.  
  85.  @3: mov dx,SBase+$e                        {DSP status port}
  86.  @2: in al,dx                               {Read status}
  87.   test al,$80                               {If high bit not set, no data}
  88.   jz @2                                     {ready}
  89.  
  90.   mov dx,Sbase+$a                           {DSP read port}
  91.   in al,dx                                  {Read status}
  92.   cmp al,$aa                                {AA indicates ready}
  93.   jnz @3
  94.   jmp @4
  95.  @5:
  96.   in al,dx                                  {Wait for response to last byte}
  97.   test al,$80                               {sent}
  98.   jnz @5
  99.   mov al,ah
  100.   out dx,al                                 {Send next byte}
  101.   ret
  102.  
  103.  @9:
  104.   push bx
  105.   mov al,$b6                                {Write count to timer #3}
  106.   out $43,al
  107.  
  108.   mov al,0                                  {Low byte of count}
  109.   out $42,al
  110.  
  111.   mov al,$10                                {High byte count}
  112.   out $42,al
  113.  
  114.   sub bx,$1000
  115.   neg bx                                    {1000h-clocks=desired count}
  116.  @10:
  117.   mov al,$80                                {Read count from timer}
  118.   out $43,al
  119.  
  120.   in  al,$42                                {Low byte}
  121.   mov ah,al
  122.   in  al,$42                                {High byte}
  123.   xchg ah,al
  124.  
  125.   cmp bx,ax                                 {Pause until count reached}
  126.   jl  @10
  127.   pop bx
  128.   ret
  129.  @4:
  130.   mov dx,SBase+$c
  131.  
  132.   mov ah,$40                                {Set time constant}
  133.   call @5
  134.  
  135.   mov ah,SampByte                           {Time divisor}
  136.   call @5
  137.  
  138.  end;
  139.  
  140.  port[$21] := port[$21] and not (1 shl SIRQ);   {Enable SB interrupt}
  141.  
  142. end;
  143.  
  144. procedure ErrorEnd;
  145. begin
  146.  WAVFile.Done;
  147.  Writeln('Error in .WAV');
  148.  Halt(1);
  149. end;
  150.  
  151. procedure PlaySound(SndLen: longint);
  152.  
  153. var AbsAddr: LongInt;
  154.     FirstBlk, SecBlk, CurBlk: Pointer;
  155.  
  156. begin
  157.  
  158.  EOB := False;
  159.  
  160.  GetMem(BlkFmt, BlockSize*2);
  161.  FirstBlk := BlkFmt;
  162.  SecBlk := pointer(longint(FirstBlk) + BlockSize);
  163.  CurBlk := FirstBlk;
  164.  
  165.  
  166.  WAVFile.Read(BlkFmt^, BlockSize);
  167.  SndLen := SndLen - BlockSize;
  168.  
  169.  repeat
  170.   AbsAddr := Seg(CurBlk^);
  171.   AbsAddr := AbsAddr * 16 +Ofs(CurBlk^);
  172.   SndLen := SndLen - BlockSize;
  173.   asm
  174.    jmp @4
  175.  
  176.   @5:
  177.    in al,dx                                 {Wait for response to last byte}
  178.    test al,$80                              {sent}
  179.    jnz @5
  180.    mov al,ah
  181.    out dx,al                                {Send next byte}
  182.    ret
  183.  
  184.   @4:
  185.  
  186.    mov bx,1
  187.    mov cx,integer(AbsAddr)
  188.    mov dx,SBase+$c
  189.  
  190.    mov al,0                                 {Clear byte high/low flip-flop}
  191.    out $c,al
  192.  
  193.    mov al,$49                               {Set memory read, single transfer,}
  194.    out $b,al                                {channel 1}
  195.  
  196.    mov al,cl                                {Enter base address}
  197.    out SDMA*2,al
  198.    mov al,ch
  199.    out SDMA*2,al
  200.  
  201.    mov ax,integer(AbsAddr+2)                {High 4 bits goes to DMA page reg}
  202.    mov dx,$83
  203.    mov cl,SDMA
  204.    sub cl,2
  205.    mov ch,2                                 {Calculate DMA page address}
  206.    shr ch,cl                                {87, 83, 81, 82 channel order}
  207.    xor dl,ch
  208.    out dx,al                                {Send page byte}
  209.  
  210.    mov ax,BlockSize                         {Set byte count}
  211.    out SDMA*2+1,al
  212.    xchg al,ah
  213.    out SDMA*2+1,al
  214.    push ax
  215.  
  216.    mov al,SDMA                              {Re-enable DMA channel 1}
  217.    out $a,al
  218.  
  219.    mov dx,SBase+$c                          {DSP port}
  220.  
  221.    mov ah,DSPCmd                            {DMA 8-bit transfer}
  222.    call @5
  223.  
  224.    pop ax                                   {Get transfer again}
  225.    mov bl,al
  226.    call @5
  227.    mov ah,bl
  228.    call @5
  229.  
  230.   end;
  231.  
  232.   DSPCmd := DSPCmd and $fe;
  233.  
  234.   if (CurBlk = FirstBlk) then CurBlk := SecBlk else CurBlk := FirstBlk;
  235.   if SndLen > 0 then WAVFile.Read(CurBlk^, BlockSize);
  236.  
  237.   while not EOB do
  238.    if Keypressed then ErrorEnd;
  239.   EOB := False;
  240.  
  241.  until (SndLen<=0);
  242. end;
  243.  
  244.  
  245. begin
  246.  
  247.  DF := ParamStr(1);
  248.  
  249.  WAVFile.Init(DF, stOpenRead);              {Open WAV file}
  250.  WAVFile.Read(BlkID, SizeOf(TWAVRec));      {Read in first block}
  251.  
  252.  if BlkID.ID = $46464952 then               {ID of WAV file}
  253.  begin
  254.   TotalSz := BlkID.Len;                     {Get total size}
  255.   repeat
  256.    WAVFile.Read(BlkID, 4);                  {Read in type chunk}
  257.    TotalSz := TotalSz - 4;                  {and update TS}
  258.  
  259.    if BlkID.ID <> $45564157 then ErrorEnd;  {Must be "WAVE"}
  260.    repeat
  261.     WAVFile.Read(BlkID, SizeOf(TWAVRec));    {Read in format chunk}
  262.     TotalSz := TotalSz - SizeOf(TWavRec);
  263.  
  264.     if BlkID.ID = $20746d66  then            {"fmt ", set WAV format}
  265.     begin
  266.      getmem(BlkFmt, BlkID.Len);
  267.      WAVFile.Read(BlkFmt^, BlkID.Len);
  268.      TotalSz := TotalSz - BlkID.Len;
  269.      with BlkFmt^ do
  270.      begin
  271.       if FTag = $200 then DSPCmd := $75 else {ADPCM 4-bit compression}
  272.        if FTag = 1 then DSPCmd := $14 else   {Normal}
  273.         ErrorEnd;
  274.       if DSPCmd = $75 then NumBits := 4 else NumBits := 8;
  275.       if NChan = 2 then DSPCmd := DSPCmd + 8; {Stereo}
  276.       SampByte := 256-(1000000 div SampR);   {Sampling rate}
  277.       BlockSize := BlkAl;                    {Size of buffer}
  278.      end;
  279.      freemem(BlkFmt, BlkID.Len);
  280.     end else
  281.  
  282.     if BlkID.ID = $61746164 then
  283.     begin
  284.      PrepareSB;                              {Perform init stuff}
  285.      TotalSz := TotalSz - BlkID.Len;
  286.      PlaySound(BlkID.Len);
  287.     end else
  288.  
  289.      ErrorEnd;
  290.    until TotalSz <= 0;
  291.   until TotalSz <= 0;
  292.  end else
  293.   ErrorEnd;
  294.  WAVFile.Done;
  295.  port[$21] := port[$21] or (1 shl SIrq);
  296. end.
  297.